home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / PIE-FLWO.ZIP / FLOGIN.PPS < prev    next >
Text File  |  1996-05-05  |  13KB  |  469 lines
  1. ; Fast Login Wizard v1.5
  2. ;
  3. ; Source code by Odin of Providence
  4. ; (C) Copyright 1996, Odin
  5. ; All Rights Reserved
  6. ;
  7. ; Compiled and working with PPLC 3.01
  8. ;
  9. ; Most of the code should be self-explaining.
  10. ; This code is here because you could learn
  11. ; something or just want to check out how I
  12. ; did this program. You can improve it or some-
  13. ; thing like that, but please don't put your
  14. ; name on it and spread or steal my routines.
  15. ;
  16. ; Oh! BTW I have used the String and Byte Variables a bit shitty, so It can
  17. ;     be really hard to figure out what they do.
  18.  
  19. ;$USEFUNCS
  20.  
  21. String cfgopts(05)
  22. String c(1)
  23. String options(8)
  24. String cfg(45)
  25. String token
  26. String line
  27. String tangent
  28. String stemp
  29. String datline
  30. String txtch
  31. String control
  32. String q
  33.  
  34. Byte len
  35. Byte i, a
  36. Byte optnr
  37. Byte temp, temp2, temp3
  38.  
  39. Declare Procedure drawprompt(String type)
  40. Declare Procedure readcfg   (String handle)
  41. Declare Procedure getline   (Byte temp, String line)
  42. Declare Procedure highlight (Byte linje, Byte bar, Boolean choice)
  43. Declare Procedure rw        (Byte option)
  44. Declare Procedure error     ()
  45. Declare Procedure about     ()
  46. Declare Procedure writeth   ()
  47. Declare Procedure login     ()
  48. Declare Procedure config    ()
  49.  
  50. Begin
  51.  
  52.   Let token=Len(U_NAME())
  53.   Let i=Len(U_NAME())
  54.  
  55.   For a=1 To i
  56.     Let txtch=Left(U_NAME(), a)
  57.     Let txtch=Right(txtch, 1)
  58.     If (txtch="."|txtch=" ") Goto nexg
  59.     Let stemp=stemp+txtch
  60.     :nexg
  61.   Next a
  62.  
  63.   If (i=>6) Let q=Left(stemp, 6)  ; This is to avoid those annoying
  64.   If (i <6) Let q=Left(stemp, i)  ; spaces in filename. For compabilty.
  65.  
  66.   Let q=q+token
  67.  
  68.   ; Woha this algothrim gets a filename for every user, a SPECIAL one for
  69.   ; every USER. No USER can never have the same FILENAME with this routine.
  70.   ; ( I think, I'm not sure =) ). If the program detects a '.' it will skip
  71.   ; it because dots doesn't work in DOS filenames! doh! =). Fuck those who
  72.   ; use special chars like '.' and other! Use normal instead!!
  73.  
  74.   If (!Exist(PPEPath()+"flogin.cfg")) error()
  75.  
  76.   FOpen  1,PPEPath()+"flogin.cfg",O_RD,DEFS
  77.   For temp=0 To 4
  78.     FGet   1,cfgopts(temp)
  79.   Next temp
  80.     FGet   1,c(0)
  81.   For temp=0 To 8
  82.     FGet   1,options(temp)
  83.     Let optnr=temp
  84.     If (options(temp)="E-O-F") Break
  85.   Next temp
  86.   FClose 1
  87.  
  88.   If (!(Exist(PPEPath()+"\DATA\"+q+".dat"))) Then
  89.     Let datline="E-O-F"
  90.     Goto nex
  91.   End If
  92.  
  93.   readcfg(U_NAME())
  94.  
  95.   ; If the users line isn't found start this routine
  96.   :nex
  97.   If (datline="E-O-F") Then                     ; If the current user not is
  98.     If (Exist(PPEPath()+"\DATA\"+q+".dat")) Delete PPEPath()+"\DATA"+q+".dat"
  99.     FCreate 1,PPEPath()+"\DATA\"+q+".dat",O_WR,DEFS
  100.       Let token=U_NAME()+";YES;YES"
  101.       For i=0 To ((optnr*2)-1)
  102.         Let token=token+";1"
  103.       Next i
  104.       FPutLn 1,token
  105.     FClose 1
  106.   End If
  107.  
  108.   getline(1,c(0))
  109.   Let c(1)=stemp
  110.   getline(2,c(0))
  111.   Let c(0)=stemp
  112.  
  113.   ;check if the datline is the "right" len (8chr+opts*2(*2))
  114.  
  115.   readcfg(U_NAME())
  116.   Let len=Len(datline)
  117.   Let a=Len(U_NAME())
  118.   Let len=len-a
  119.  
  120.   If (!(len=(8+((optnr*2)*2)))) Then
  121.     Cls
  122.     PrintLn "IT SEEMS LIKE *YOUR* DATA LINE IS INVALID...ERASING LINE."
  123.     PrintLn "GENERATING A DEFAULT LINE..."
  124.     PrintLn "PLEASE CHANGE TO YOUR OWN SETTINGS BY RUNING THE CFG PPE."
  125.     PrintLn
  126.     PrintLn "THIS ERROR OCCURED BECAUSE SOMETHING SYSOP DID, NOT YOU."
  127.     If (Exist(PPEPath()+"\DATA\"+q+".dat")) Delete PPEPath()+"\DATA\"+q+".dat"
  128.     FCreate 1,PPEPath()+"\DATA\"+q+".dat",O_WR,DEFS
  129.       Let token=U_NAME()+";YES;YES"
  130.       For i=0 To ((optnr*2)-1)
  131.         Let token=token+";1"
  132.       Next i
  133.       FPutLn 1,token
  134.     FClose 1
  135.     Delay 50
  136.   End If
  137.  
  138.   ; Maybe I could have done the lines above smarter...but I haven't time
  139.   ; to do that! =) It works anyway, thats the main thing.
  140.  
  141.   readcfg(U_NAME())
  142.  
  143.   getline(2,datline)
  144.   Let cfg(0)=stemp
  145.   getline(3,datline)
  146.   Let cfg(1)=stemp
  147.  
  148.   Let token=Upper(GetToken())
  149.  
  150.   If (token="/CFG") Then
  151.     Cls
  152.     Print c(0)+"LOADING PLEASE WAIT ["
  153.     For i=0 To ((optnr*2)-1)
  154.       Print c(0)+"■"
  155.     Next i
  156.       Print c(0)+"]"
  157.     For i=0 To ((optnr*2)-1)    ; get all the 0 and 1:s
  158.       AnsiPos 22+i,1 : Print c(1)+"■"
  159.       getline(4+i,datline)      ; It starts on nr 4 (1;2;3;[4];5;6)
  160.       Let cfg(2+i)=stemp        ; +2 because 1 and 2 is used
  161.     Next i
  162.     config()
  163.   End If
  164.  
  165.   Cls
  166.  
  167.   login()
  168.  
  169. End
  170.  
  171. Procedure login()
  172.  
  173.   If (cfg(1)="NO ") Then
  174.     Let cfgopts(5)=cfg(0)
  175.     writeth()
  176.   End If
  177.  
  178.   drawprompt(cfg(0))
  179.   Let cfgopts(5)=cfg(0)
  180.  
  181.   :choices
  182.   Let tangent=""
  183.  
  184.   :choices1
  185.   If (!(tangent="")) Goto check
  186.   Let tangent=Inkey()
  187.   Goto choices1
  188.  
  189.   :check
  190.   If (((tangent="LEFT"|tangent="RIGHT"))&Upper(cfgopts(5))="YES") Then Let cfgopts(5)="NO "
  191.   Else If (((tangent="RIGHT"|tangent="LEFT"))&Upper(cfgopts(5))="NO ") Then Let cfgopts(5)="YES"
  192.   End If
  193.  
  194.   If (tangent=CHR(13)&(Upper(cfgopts(5))="YES"|Upper(cfgopts(5))="NO ")) writeth()
  195.  
  196.   drawprompt(cfgopts(5))
  197.  
  198.   Goto choices
  199.  
  200. End Proc
  201.  
  202. Procedure writeth()
  203.  
  204.   readcfg(U_NAME())
  205.  
  206.   If (cfgopts(5)="YES") Then
  207.     For i=(optnr+4) To ((optnr*2)+3)
  208.       getline(i, datline)          ; Output line: String stemp
  209.       If (stemp="1") rw(i-optnr-4) ; -4 and -optnr because 'i' starts on 0
  210.     Next i
  211.   End If
  212.   If (cfgopts(5)="NO ") Then
  213.     For i=4 To optnr+3
  214.       getline(i, datline)          ; Output line: String stemp
  215.       If (stemp="1") rw(i-4)       ; -4 because 'i' starts on 0
  216.     Next i
  217.   End If
  218.  
  219.   End
  220.  
  221. End Proc
  222.  
  223. Procedure getline(Byte temp, String line)
  224.  
  225.   Let len=Len(line)
  226.   Let control=0
  227.   Let stemp=""
  228.  
  229.   For a=1 To len
  230.     Let txtch=Left(line, a)
  231.     Let txtch=Right(txtch, 1)
  232.     If (txtch=";") Then
  233.       Inc control
  234.       If (control=temp) Break
  235.       Let stemp=""
  236.     End If
  237.     If (!(txtch=";")) Let stemp=stemp+txtch
  238.   Next a
  239.  
  240. End Proc
  241.  
  242. Procedure rw(Byte option)
  243.  
  244.   getline(2,options(option))
  245.  
  246.   Let token=(Left(stemp,1))   ; let's reuse String token
  247.   Let len=Len(stemp)          ; the next 3 Let takes away the first char
  248.   Let len=len-1
  249.   Let stemp=Right(stemp,len)
  250.  
  251.   If (token="%") DispFile stemp,DEFS
  252.   If (token="!") Call stemp
  253.  
  254. End Proc
  255.  
  256. Procedure drawprompt(String type)
  257.  
  258.   Cls : PrintLn : PrintLn
  259.   If (type="YES") PrintLn cfgopts(0)+" "+cfgopts(2)+" "+cfgopts(3)
  260.   If (type="NO ") PrintLn cfgopts(0)+" "+cfgopts(1)+" "+cfgopts(4)
  261.  
  262. End Proc
  263.  
  264. Procedure readcfg(String handle)
  265.  
  266.   FOpen  1,PPEPath()+"\DATA\"+q+".dat",O_RD,DEFS
  267.     FGet 1,datline
  268.   FClose 1
  269.  
  270.   getline(1,datline)
  271.  
  272.   If (!(stemp=handle)) Let datline="E-O-F"
  273.  
  274. End Proc
  275.  
  276. Procedure config()
  277.  
  278.   Cls
  279.   DispFile PPEPath()+"flogin.pcb",DEFS
  280.  
  281.   For i=0 To 2
  282.     highlight(3, i, False)
  283.     highlight(0, i, False)
  284.   Next i
  285.  
  286.   For i=0 To (optnr-1)
  287.     highlight(2, i, False)
  288.     highlight(1, i, False)
  289.   Next i
  290.  
  291.   Let temp2=0
  292.   Let temp3=0
  293.  
  294.   highlight(temp3, temp2, True)
  295.  
  296.   :choices
  297.   Let tangent=""
  298.  
  299.   :choices1
  300.   If (!(tangent="")) Goto check
  301.   Let tangent=Inkey()
  302.   Goto choices1
  303.  
  304.   :check
  305.   If (tangent="UP"&temp3<3) Then
  306.     highlight(temp3, temp2, False)
  307.     Inc temp3
  308.     Let temp2=0
  309.   End If
  310.   If (tangent="DOWN"&temp3>0) Then
  311.     highlight(temp3, temp2, False)
  312.     Dec temp3
  313.     Let temp2=0
  314.   End If
  315.   If (((temp3=3&temp2<1)|(temp3=0&temp2<1))&tangent="RIGHT") Then
  316.     highlight(temp3, temp2, False)
  317.     Inc temp2
  318.   End If
  319.   If ((temp3=0|temp3=1|temp3=2|temp3=3)&tangent="LEFT"&temp2>0) Then
  320.     highlight(temp3, temp2, False)
  321.     Dec temp2
  322.   End If
  323.   If ((temp3=1|temp3=2)&tangent="RIGHT"&temp2<(optnr-1)) Then
  324.     highlight(temp3, temp2, False)
  325.     Inc temp2
  326.   End If
  327.  
  328.   If (tangent=CHR(032)|tangent=CHR(013)) Then
  329.     If (temp3=0) Then
  330.       If (temp2=0) Then
  331.         Delete PPEPath()+"\DATA\"+q+".dat"
  332.         FCreate 1,PPEPath()+"\DATA\"+q+".dat",O_WR,DEFS
  333.         Let token=U_NAME()+";"+cfg(0)+";"+cfg(1)
  334.         For i=2 To ((optnr*2)+1)
  335.           Let token=token+";"+cfg(i)
  336.         Next i
  337.         FPutLn 1,token
  338.         FClose 1
  339.         Cls : End
  340.       End If
  341.       If (temp2=1) about()
  342.     End If
  343.     If (temp3=2) Then
  344.       If (cfg(temp2+2)="0") Then
  345.         Let cfg(temp2+2)="1"
  346.         AnsiPos 05,12+temp2 : Print c(0)+"[X]"
  347.       Else If (cfg(temp2+2)="1") Then
  348.         Let cfg(temp2+2)="0"
  349.         AnsiPos 05,12+temp2 : Print c(1)+"[ ]"
  350.       End If
  351.     End If
  352.     If (temp3=1) Then
  353.       If (cfg(optnr+temp2+2)="0") Then
  354.         Let cfg(optnr+temp2+2)="1"
  355.         AnsiPos 38,12+temp2 : Print c(0)+"[X]"
  356.       Else If (cfg(optnr+temp2+2)="1") Then
  357.         Let cfg(optnr+temp2+2)="0"
  358.         AnsiPos 38,12+temp2 : Print c(1)+"[ ]"
  359.       End If
  360.     End If
  361.     If (temp3=3) Then
  362.       If (temp2=0&cfg(0)="YES") Then Let cfg(0)="NO "
  363.       Else If (temp2=0) Then Let cfg(0)="YES" : End If
  364.       If (temp2=1&cfg(1)="YES") Then Let cfg(1)="NO "
  365.       Else If (temp2=1) Then Let cfg(1)="YES" : End If
  366.     End If
  367.   End If
  368.  
  369.   highlight(temp3, temp2, True)
  370.  
  371.   Goto choices
  372.  
  373. End Proc
  374.  
  375. Procedure highlight(Byte linje, Byte bar, Boolean choice)
  376.  
  377.   If (bar=0&linje=3) Then
  378.     AnsiPos 05,09
  379.     If (choice=True)  Print c(0)+"DEFAULT ALTERANTIVE: ["+c(1)+cfg(0)+c(0)+"]"
  380.     If (choice=False) Print c(0)+"DEFAULT ALTERANTIVE: ["+c(1)+Lower(cfg(0))+c(0)+"]"
  381.   End If
  382.  
  383.   If (bar=1&linje=3) Then
  384.     AnsiPos 38,09
  385.     If (choice=True)  Print c(0)+"USE FAST LOGIN PROMPT: ["+c(1)+cfg(1)+c(0)+"]"
  386.     If (choice=False) Print c(0)+"USE FAST LOGIN PROMPT: ["+c(1)+Lower(cfg(1))+c(0)+"]"
  387.   End If
  388.  
  389.   If (bar=0&linje=0) Then
  390.     AnsiPos 05,21
  391.     If (choice=True)  Print c(0)+"["+c(1)+"END PPE"+c(0)+"]"
  392.     If (choice=False) Print c(0)+"["+c(1)+"end ppe"+c(0)+"]"
  393.   End If
  394.  
  395.   If (bar=1&linje=0) Then
  396.     AnsiPos 15,21
  397.     If (choice=True)  Print c(0)+"["+c(1)+"ABOUT"+c(0)+"]"
  398.     If (choice=False) Print c(0)+"["+c(1)+"about"+c(0)+"]"
  399.   End If
  400.  
  401.   If (linje=1|linje=2) Then
  402.     getline(1,options(bar))
  403.     If (linje=1) Then
  404.       AnsiPos 38,12+bar
  405.       If (choice=False) Then
  406.         If (cfg(optnr+bar+2)="0") Print c(0)+"[ ] "+stemp
  407.         If (cfg(optnr+bar+2)="1") Print c(0)+"[X] "+stemp
  408.       End If
  409.       If (choice=True) Then
  410.         If (cfg(optnr+bar+2)="0") Print c(1)+"[ ]"
  411.         If (cfg(optnr+bar+2)="1") Print c(1)+"[X]"
  412.       End If
  413.     End If
  414.     If (linje=2) Then
  415.       AnsiPos 05,12+bar
  416.       If (choice=False) Then
  417.         If (cfg(2+bar)="0") Print c(0)+"[ ] "+stemp
  418.         If (cfg(2+bar)="1") Print c(0)+"[X] "+stemp
  419.       End If
  420.         If (choice=True) Then
  421.         If (cfg(2+bar)="0") Print c(1)+"[ ]"
  422.         If (cfg(2+bar)="1") Print c(1)+"[X]"
  423.       End If
  424.     End If
  425.   End If
  426.  
  427. End Proc
  428.  
  429. Procedure about()
  430.  
  431.   Cls
  432.   PrintLn c(0)+"                                            █▀▀▀▓"
  433.   PrintLn "             ▀  ▀ █▀▓▀▀▀▀▀█▄▄▓▄▄▄▄▄▄▓▀▀▀█▄▄▄▓ ░ ▀▓▀▀▀█▄"
  434.   PrintLn "            ▄     ▓ ▄▄▓▄▓▄▄▄▄▄ ▀ ■▄▄▄▄▓ ▄■ ▄▄▄▓▄▄▄▄▓▄ ▀▀▀█▀ ▀  ▀"
  435.   PrintLn "        ▄   ▓▄■   ▒  █▄██▓ ▐▄██▄  ░█████▌   █████ ██▓▄▓ u▓   ▄  ▄▓"
  436.   PrintLn "     ░▒▓█▓█▓███▒█ ░  ▓████  █▓██▌  ███▓█    █▓███ ▐██▓█▌Z▒ █▒██▓█▒██▓▒░"
  437.   PrintLn "     ░▒▓█▒████▓██ ■ ▐██▓██  █▄██▌ ▐█▓███   ▐█████ ▐██▄█▌!░ ███▓█████▓▒░"
  438.   PrintLn "     ░▒▓████▓█▒█▓ ░ ▐█████  ██▓▀  ▐█▄███   ▐██▓██▄█▀▓█▀  ■ ▓████▓█▓█▓▒░"
  439.   PrintLn "         ▐▀   ▓   ▒  █████■▄▀▀  ▒  ███▓█    █████ ▄▄▄▓▄  ░   ▐▀  ▀■"
  440.   PrintLn "                  ▓  ██▀▐█  ▄▓▄▄▓ ▄██▓█▓    ▀■███ ████▓  ▒"
  441.   PrintLn "       "+c(1)+"1993"+c(0)+"       █ ▓▀▓▀▀▀▀ █  ▀█ ▓▀▀▀▀▀▓ █▄▄  ▓▀▓▀▀▀▀   ▓       "+c(1)+"1996"+c(0)
  442.   PrintLn "                  █▄▄▄▄▄█▀▓▀▀   █▄▄▄█▀▓ ▒ ▓ ▀▐▄■▄▄▄▓▄█▀▓▀▀ ▀  ▀"
  443.   PrintLn "                  ▄       ▒           ▓ ░ ▒            ▒ ▀"
  444.   PrintLn "                          ░           ▓▄▄▄░              ▄"
  445.   PrintLn "                       'LIVE AND KICKING SINCE 1993'"
  446.   PrintLn "┌─────────────────────────────────────────────────────────────────────────────┐"
  447.   PrintLn "│ [FAST LOGIN WIZARD v1.5a CODED BY "+c(1)+"ODIN"+c(0)+" OF "+c(1)+"PROVIDENCE "+c(0)+"IN DA NINETYNINETYSIX] │"
  448.   PrintLn "├─────────────────────────────────────────────────────────────────────────────┤"
  449.   PrintLn "│ [DO YOU WANT PURE QUALiTY? JUST CHECK OUT YOUR NEREAST BOARD FOR OUR PPE:s] │"
  450.   PrintLn "├─────────────────────────────────────────────────────────────────────────────┤"
  451.   PrintLn "│ WWW   : "+c(1)+"http://infinity.beve.blacksburg.va.us/~odin/pie!.html "+c(0)+"(800x600x256) │"
  452.   PrintLn "│ E-MAIL: "+c(1)+"odin@infinity.beve.blacksburg.va.us     "+c(0)+" THE IRC:"+c(1)+" #PIE on the EFNet"+c(0)+" │"
  453.   Print "└─────────────────────────────────────────────────────────────────────────────┘ "
  454.   Wait
  455.  
  456.   config()
  457.  
  458. End Proc
  459.  
  460. Procedure error()
  461.  
  462.   Cls
  463.   Print "CAN'T FIND 'FLOGIN.CFG'. PLEASE INFORM SYSOP. PPE DISABLED."
  464.   PrintLn : PrintLn
  465.   Wait
  466.   End
  467.  
  468. End Proc
  469.